home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Tk / win / tkWinInit.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-07-21  |  2.6 KB  |  97 lines
  1. /* 
  2.  * tkWinInit.c --
  3.  *
  4.  *    This file contains Windows-specific interpreter initialization
  5.  *    functions.
  6.  *
  7.  * Copyright (c) 1995 Sun Microsystems, Inc.
  8.  *
  9.  * See the file "license.terms" for information on usage and redistribution
  10.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11.  *
  12.  * SCCS: @(#) tkWinInit.c 1.13 96/03/18 14:22:29
  13.  */
  14.  
  15. #include "tkWinInt.h"
  16.  
  17. /*
  18.  * The following string is the startup script executed in new
  19.  * interpreters.  It looks on disk in several different directories
  20.  * for a script "tk.tcl" that is compatible with this version
  21.  * of Tk.  The tk.tcl script does all of the real work of
  22.  * initialization.
  23.  */
  24.  
  25. #ifndef WIN32
  26. static char *initScript =
  27. "proc init {} {\n\
  28.     global tk_library tk_version tk_patchLevel env\n\
  29.     rename init {}\n\
  30.     set dirs {}\n\
  31.     if [info exists env(TK_LIBRARY)] {\n\
  32.     lappend dirs $env(TK_LIBRARY)\n\
  33.     }\n\
  34.     lappend dirs $tk_library\n\
  35.     lappend dirs [file dirname [info library]]/lib/tk$tk_version\n\
  36.     lappend dirs [file dirname [file dirname [info nameofexecutable]]]/lib/tk$tk_version\n\
  37.     if [string match {*[ab]*} $tk_patchLevel] {\n\
  38.     set lib tk$tk_patchLevel\n\
  39.     } else {\n\
  40.     set lib tk$tk_version\n\
  41.     }\n\
  42.     lappend dirs [file dirname [file dirname [pwd]]]/$lib/library\n\
  43.     lappend dirs [file dirname [pwd]]/library\n\
  44.     foreach i $dirs {\n\
  45.     set tk_library $i\n\
  46.     if ![catch {uplevel #0 source [list $i/tk.tcl]}] {\n\
  47.         return\n\
  48.     }\n\
  49.     }\n\
  50.     set msg \"Can't find a usable tk.tcl in the following directories: \n\"\n\
  51.     append msg \"    $dirs\n\"\n\
  52.     append msg \"This probably means that Tk wasn't installed properly.\n\"\n\
  53.     error $msg\n\
  54. }\n\
  55. init";
  56. #endif
  57.  
  58. /*
  59.  *----------------------------------------------------------------------
  60.  *
  61.  * TkPlatformInit --
  62.  *
  63.  *    Performs Windows-specific interpreter initialization related to the
  64.  *      tk_library variable.
  65.  *
  66.  * Results:
  67.  *    A standard Tcl completion code (TCL_OK or TCL_ERROR).  Also
  68.  *    leaves information in interp->result.
  69.  *
  70.  * Side effects:
  71.  *    Sets "tk_library" Tcl variable, runs "tk.tcl" script.
  72.  *
  73.  *----------------------------------------------------------------------
  74.  */
  75.  
  76. int
  77. TkPlatformInit(interp)
  78.     Tcl_Interp *interp;
  79. {
  80. #ifdef STk_CODE
  81.     extern char *STk_library_path;
  82.  
  83.     Tcl_SetVar(interp, "*stk-library*", STk_library_path, 
  84.            STk_STRINGIFY | TCL_GLOBAL_ONLY);
  85.     return TCL_OK;
  86. #else
  87.     char *libDir;
  88.  
  89.     libDir = Tcl_GetVar(interp, "tk_library", TCL_GLOBAL_ONLY);
  90.     if (libDir == NULL) {
  91.     Tcl_SetVar(interp, "tk_library", ".", TCL_GLOBAL_ONLY);
  92.     }
  93.  
  94.     return Tcl_Eval(interp, initScript);
  95. #endif
  96. }
  97.